home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / CRS / crs47.d81 / 64alv2a.sfx / lynx create (.txt) < prev    next >
Commodore BASIC  |  1990-02-12  |  6KB  |  270 lines
  1. 1 POKE 53280,11:POKE 53281,12:PRINT "[147]"CHR$(142)
  2. 2 PRINT TAB(13)"[151]LYNX COMPILER"
  3. 3 PRINT TAB(13)"[163][163][163][163][163][163][163][163][163][163][163][163][163]"
  4. 4 PRINT TAB(9)"(C) 1989  WILL CORLEY"
  5. 5 DIM S$(5),T$(145),PN$(145),FT(145),FS(145),BL(145),LN(145)
  6. 6 DIM RT(145),RL(145),RS(145),LT(145),LS(145),ZT(145),ZS(145)
  7. 7 DIM BT(6,120),BS(6,120),TS(6),SS(6)
  8. 8 K$=CHR$(0)
  9. 9 SD$=" 8=SOURCE DRIVE":SD=VAL(SD$)
  10. 10 BA=193*256:TEM=49152
  11. 11 FOR X=0 TO 40:READ Y:POKE X+TEM,Y:NEXT X
  12. 12 HD$="":FOR X=1 TO 94:READ Y:HD$=HD$+CHR$(Y):NEXT X
  13. 13 INPUT "INSERT DISK";A$
  14. 14 OPEN 15,SD,15,"I0":GOSUB 231
  15. 15 OPEN 2,SD,2,"#":GOSUB 231
  16. 16 T=18:S=1:N=0:W=N:BT=N
  17. 17 PRINT "[145][Y[146]][151]ES [N[146]][151]O [A[146]][151]UTO [G[146]][151]O [E[146]][151]XIT"
  18. 18 GOSUB 178:X=0
  19. 19 ZX=X*32:F$="":C=PEEK(BA+2+ZX)
  20. 20 IF N=143 AND S3=0 THEN 37
  21. 21 IF (C AND 128)<> 128 THEN 37
  22. 22 C=(C AND 15):IF C=0 THEN 37
  23. 23 GOSUB 181
  24. 24 DT=PEEK(BA+3+ZX):DS=PEEK(BA+4+ZX)
  25. 25 GOSUB 186
  26. 26 GOSUB 189
  27. 27 IF (H<>0 AND DT=18) THEN 37
  28. 28 POKE 212,1:PRINT F$:POKE 212,0
  29. 29 PRINT "[145]";TAB(17) T$
  30. 30 IF W=1 THEN A$="Y":GOTO 32
  31. 31 POKE 198,0:WAIT 198,1:GET A$
  32. 32 IF A$="G" THEN PRINT "[145][145]":GOTO 39
  33. 33 IF A$="A" THEN W=1:GOTO 30
  34. 34 IF A$="E" THEN CLOSE 2:CLOSE 15:END
  35. 35 IF A$<>"Y" THEN PRINT "[145][145]":GOTO 37
  36. 36 GOSUB 191
  37. 37 X=X+1:IF X<8 THEN 19
  38. 38 IF T<>0 THEN 18
  39. 39 PRINT "                    ":CLOSE 2:CLOSE 15
  40. 40 OPEN 15,SD,15,"UJ"
  41. 41 TI$="000000":WAIT 162,128
  42. 42 GET#15,A$:IF ST<>64 THEN 42
  43. 43 CLOSE 15
  44. 44 IF N=0 THEN END
  45. 45 GETA$:IF A$="E" THEN N=0:GOTO 44
  46. 46 BL(N+1)=0
  47. 47 OPEN 15,SD,15,"I0":GOSUB 231
  48. 48 PRINT#15,"M-R"CHR$(250)CHR$(2)CHR$(3)
  49. 49 GET#15,D$:L=ASC(D$+K$)
  50. 50 GET#15,D$
  51. 51 GET#15,D$:H=ASC(D$+K$)*256+L
  52. 52 CLOSE 15
  53. 53 IF (N/6+5)<H THEN 56
  54. 54 PRINT "DISK FULL"
  55. 55 POKE 198,0:WAIT 198,1:END
  56. 56 LX$=""
  57. 57 INPUT "FINAL LYNX FILENAME";LX$
  58. 58 IF LEN(LX$)>13 THEN 56
  59. 59 IF LEN(LX$)=0 THEN 56
  60. 60 LX$=LX$+".LNX"
  61. 61 OPEN 15,SD,15:OPEN 3,SD,3,"0:"+LX$+","+"P,R"
  62. 62 INPUT#15,E,E$,ET,ES:CLOSE 3:CLOSE 15
  63. 63 IF E>19 THEN 66
  64. 64 PRINT "FILE EXISTS[151]"
  65. 65 POKE 198,0:WAIT 198,1:GOTO 56
  66. 66 OPEN 15,SD,15,"I0"
  67. 67 GOSUB 231
  68. 68 OPEN 2,SD,2,"#":GOSUB 231
  69. 69 FOR Z=1 TO N:PRINT "LINKING "PN$(Z)
  70. 70 BV=0
  71. 71 IF BL(Z)=0 THEN 88
  72. 72 IF T$(Z)="R" THEN 81
  73. 73 T=FT(Z):S=FS(Z)
  74. 74 GOSUB 225:BV=BV+1
  75. 75 GET#2,A$:T1=ASC(A$+K$)
  76. 76 GET#2,A$:S1=ASC(A$+K$)
  77. 77 IF T1<>0 THEN T=T1:S=S1:GOTO 74
  78. 78 IF BV<>BL(Z) THEN 228
  79. 79 LT(Z)=T:LS(Z)=S:LN(Z)=S1
  80. 80 GOTO 88
  81. 81 T=RT(Z):S=RS(Z)
  82. 82 GOSUB 225:BV=BV+1
  83. 83 GET#2,A$:T1=ASC(A$+K$)
  84. 84 GET#2,A$:S1=ASC(A$+K$)
  85. 85 IF T1<>0 THEN T=T1:S=S1:GOTO 82
  86. 86 ZT(Z)=T:ZS(Z)=S
  87. 87 GOTO 73
  88. 88 NEXT Z
  89. 89 FOR Z=1 TO N
  90. 90 IF BL(Z)=0 THEN 108
  91. 91 IF T$(Z)="R" THEN 104
  92. 92 T=LT(Z):S=LS(Z):GOSUB 225
  93. 93 IF Z=N THEN 108
  94. 94 Y=Z+1
  95. 95 IF BL(Y)<>0 THEN 98
  96. 96 Y=Y+1:IF Y<N+1 THEN 95
  97. 97 GOTO 108
  98. 98 IF Y>N THEN 108
  99. 99 IF T$(Y)="R" THEN 101
  100. 100 PRINT#2,CHR$(FT(Y));CHR$(FS(Y));:GOTO 102
  101. 101 PRINT#2,CHR$(RT(Y));CHR$(RS(Y));
  102. 102 PRINT#15,"U2";2;0;T;S:GOSUB 231
  103. 103 GOTO 108
  104. 104 T=ZT(Z):S=ZS(Z):GOSUB 225
  105. 105 PRINT#2,CHR$(FT(Z));CHR$(FS(Z));
  106. 106 PRINT#15,"U2";2;0;T;S:GOSUB 231
  107. 107 GOTO 92
  108. 108 NEXT Z:CLOSE 2
  109. 109 PRINT "CREATING LYNX HEADER"
  110. 110 PRINT#15,"I0":GOSUB 231:OPEN 3,SD,3,"0:"+LX$+","+"P,W":GOSUB 231
  111. 111 PRINT#3,HD$
  112. 112 PRINT#3,"    *LYNX XVII   WILL CORLEY":PRINT#3,N
  113. 113 FOR Z=1 TO N
  114. 114 PRINT#3,PN$(Z):PRINT#3,BL(Z):PRINT#3,T$(Z)
  115. 115 IF T$(Z)="R" THEN PRINT#3,RL(Z)
  116. 116 PRINT#3,LN(Z)
  117. 117 NEXT Z:CLOSE 3:GOSUB 231
  118. 118 PRINT "WRITING DIRECTORY":PRINT#15,"I0":GOSUB 231
  119. 119 IF LEN(LX$)<16 THEN LX$=LX$+CHR$(160):GOTO 119
  120. 120 OPEN 2,SD,2,"#":GOSUB 231:T=18:S=1:F1=0
  121. 121 PRINT#15,"U1";2;0;T;S:GOSUB 231
  122. 122 PRINT#15,"B-P";2;0:POKE 251,0:POKE 252,193:SYSTEM
  123. 123 T1=PEEK(BA):S1=PEEK(BA+1)
  124. 124 F3=0:X=0
  125. 125 ZX=X*32:F$="":GOSUB 186
  126. 126 IF F$=LX$ THEN 133
  127. 127 IF (F1=N) OR (PN$(F1+1)<>F$) THEN 129
  128. 128 PRINT#15,"B-P";2;X*32+2:PRINT#2,K$;:F3=1:F1=F1+1
  129. 129 X=X+1:IF X<8 THEN 125
  130. 130 IF F3=1 THEN PRINT#15,"U2";2;0;T;S:GOSUB 231
  131. 131 IF T1=0 THEN 139
  132. 132 T=T1:S=S1:GOTO 121
  133. 133 HB=PEEK(BA+31+ZX)*256+PEEK(BA+30+ZX):BT=HB+BT
  134. 134 FT(0)=PEEK(BA+3+ZX):FS(0)=PEEK(BA+4+ZX)
  135. 135 PRINT#15,"B-P";2;X*32+30
  136. 136 H=INT(BT/256):L=BT-(H*256)
  137. 137 PRINT#2,CHR$(L);CHR$(H);
  138. 138 F3=1:GOTO 129
  139. 139 T=FT(0):S=FS(0)
  140. 140 PRINT#15,"U1";2;0;T;S:GOSUB 231
  141. 141 LZ=LEN(HD$)+3
  142. 142 PRINT#15,"B-P";2;LZ
  143. 143 PRINT#2,STR$(HB);
  144. 144 PRINT#15,"U2";2;0;T;S
  145. 145 GOTO 147
  146. 146 PRINT#15,"U1";2;0;T;S:GOSUB 231
  147. 147 PRINT#15,"B-P";2;0
  148. 148 GET#2,D$:T1=ASC(D$+K$)
  149. 149 GET#2,D$:S1=ASC(D$+K$)
  150. 150 IF T1<>0 THEN T=T1:S=S1:GOTO 146
  151. 151 Y=1
  152. 152 IF BL(Y)<>0 THEN 155
  153. 153 Y=Y+1:IF Y<N+1 THEN 152
  154. 154 GOTO 159
  155. 155 PRINT#15,"B-P";2;0
  156. 156 A$=CHR$(FT(Y))+CHR$(FS(Y)):IF T$(Y)="R" THEN A$=CHR$(RT(Y))+CHR$(RS(Y))
  157. 157 PRINT#2,A$;
  158. 158 PRINT#15,"U2";2;0;T;S:GOSUB 231
  159. 159 CLOSE 2:CLOSE 15:END
  160. 160 I$="":C=0
  161. 161 POKE 646,1:POKE 647,1:POKE 204,C:POKE 198,0:WAIT 198,1:GET A$
  162. 162 IF A$=CHR$(34) OR A$=CHR$(141) THEN 161
  163. 163 IF A$<>CHR$(13) THEN 167
  164. 164 POKE 204,1:IF LEN(I$)=CM THEN 166
  165. 165 A$=" "+A$
  166. 166 PRINT A$:RETURN
  167. 167 POKE 204,1:IF LEN(I$)=CM THEN 169
  168. 168 A=(PEEK(210)*256+PEEK(209)+PEEK(211)):POKE A,PEEK(A) AND 127
  169. 169 IF A$<>CHR$(20) THEN 173
  170. 170 IF LEN(I$)=0 THEN PRINT " [157]";:GOTO 161
  171. 171 I$=LEFT$(I$,LEN(I$)-1)
  172. 172 PRINT "[157] [157]";:C=0:GOTO 161
  173. 173 IF LEN(I$)=CM THEN 161
  174. 174 IF ASC(A$)=160 THEN PRINT " [146]";:GOTO 176
  175. 175 POKE 212,1:PRINT A$;:POKE 212,0
  176. 176 I$=I$+A$:IF LEN(I$)=CM THEN C=1
  177. 177 GOTO 161
  178. 178 PRINT#15,"U1";2;0;T;S:GOSUB 231:PRINT#15,"B-P";2;0:GOSUB 231
  179. 179 POKE 251,0:POKE 252,193:SYSTEM:T=PEEK(BA):S=PEEK(BA+1):RETURN
  180. 180 IF C=0 THEN T$="DEL"
  181. 181 IF C=1 THEN T$="SEQ"
  182. 182 IF C=2 THEN T$="PRG"
  183. 183 IF C=3 THEN T$="USR"
  184. 184 IF C=4 THEN T$="REL"
  185. 185 RETURN
  186. 186 FOR Y=BA+5+ZX TO BA+20+ZX
  187. 187 D$=CHR$(PEEK(Y))
  188. 188 F$=F$+D$:NEXT Y:RETURN
  189. 189 H=PEEK(BA+31+ZX)*256+PEEK(BA+30+ZX)
  190. 190 RT=PEEK(BA+21+ZX):RS=PEEK(BA+22+ZX):RL=PEEK(BA+23+ZX):RETURN
  191. 191 N=N+1
  192. 192 PN$(N)=F$
  193. 193 FT(N)=DT
  194. 194 FS(N)=DS
  195. 195 BL(N)=H
  196. 196 BT=BT+H
  197. 197 T$(N)=LEFT$(T$,1)
  198. 198 RT(N)=RT
  199. 199 RS(N)=RS
  200. 200 RL(N)=RL
  201. 201 RETURN
  202. 202 D=16-LEN(PN$(Z))
  203. 203 IF D=0 THEN 207
  204. 204 FOR Y=1 TO D
  205. 205 A$=A$+CHR$(160)
  206. 206 NEXT Y
  207. 207 B$=LEFT$(C$,3)
  208. 208 RETURN
  209. 209 A$=A$+B$+C$
  210. 210 H=INT(BL(Z)/256)
  211. 211 L=BL(Z)-(H*256)
  212. 212 A$=A$+CHR$(L)+CHR$(H)
  213. 213 IF X<>7 THEN A$=A$+K$+K$
  214. 214 Z=Z+1:RETURN
  215. 215 IF LEN(A$)<254 THEN A$=A$+K$:GOTO 215
  216. 216 S=ND
  217. 217 ND=ND+3
  218. 218 IF ND>18 THEN ND=ND-17
  219. 219 PRINT#15,"B-P";2;0
  220. 220 IF Z>N THEN PRINT#2,K$;CHR$(255);:GOTO 222
  221. 221 PRINT#2,CHR$(18);CHR$(ND);
  222. 222 PRINT#2,A$;
  223. 223 PRINT#15,"U2";2;0;18;S:GOSUB 231
  224. 224 RETURN
  225. 225 PRINT#15,"U1";2;0;T;S:GOSUB 231
  226. 226 PRINT#15,"B-P";2;0:GOSUB 231
  227. 227 RETURN
  228. 228 PRINT "FILE LENGTH ERROR"
  229. 229 CLOSE 2:CLOSE 15
  230. 230 POKE 198,0:WAIT 198,1:END
  231. 231 INPUT#15,E,E$,ET,ES:IF E>19 THEN CLOSE 2:CLOSE 3:GOTO 233
  232. 232 RETURN
  233. 233 PRINT E;E$;ET;ES
  234. 234 END
  235. 235 IF BL(Z)<122 THEN SS=1:RETURN
  236. 236 IF BL(Z)<243 THEN SS=2:RETURN
  237. 237 IF BL(Z)<364 THEN SS=3:RETURN
  238. 238 IF BL(Z)<485 THEN SS=4:RETURN
  239. 239 IF BL(Z)<606 THEN SS=5:RETURN
  240. 240 SS=6:RETURN
  241. 241 A$="":FOR X=1 TO 28:GET#2,B$:A$=A$+B$:NEXT:GET#2,B$
  242. 242 B$="*LYNX":X=1:RZ=0
  243. 243 IF MID$(A$,X,5)=B$ THEN RZ=1:RETURN
  244. 244 IF MID$(A$,X,4)="LYNX"  THEN RETURN
  245. 245 X=X+1:IF X<22 THEN 243
  246. 246 CLOSE 2:CLOSE 15:S3=-1
  247. 247 PRINT "NOT A LYNXED FILE"
  248. 248 POKE 198,0:WAIT 198,1:END
  249. 249 OPEN 15,SD,15,"I0":GOSUB 231
  250. 250 OPEN 2,SD,2,"0:"+PN$(1)+","+T$(1)+",R":GOSUB 231
  251. 251 GET#2,A$:A=ASC(A$+K$)
  252. 252 GET#2,A$:B=ASC(A$+K$)
  253. 253 ZR=0:IF (A=1 AND B=8) THEN ZR=1
  254. 254 CLOSE 2:CLOSE 15:RETURN
  255. 255 DATA 162,2,32,198,255,160,0,32,228,255
  256. 256 DATA 145,251,200,208,248,32,204,255,96,162
  257. 257 DATA 2,32,198,255,162,25,160,0,32,228
  258. 258 DATA 255,145,251,200,202,208,247,32,204,255
  259. 259 DATA 96
  260. 260 DATA 1,8,91,8,10,0,151,53,51,50
  261. 261 DATA 56,48,44,48,58,151,53,51,50,56
  262. 262 DATA 49,44,48,58,151,54,52,54,44,194
  263. 263 DATA 40,49,54,50,41,58,153,34,147,17
  264. 264 DATA 17,17,17,17,17,17,17,34,58,153
  265. 265 DATA 34,32,32,32,32,32,85,83,69,32
  266. 266 DATA 76,89,78,88,32,84,79,32,68,73
  267. 267 DATA 83,83,79,76,86,69,32,84,72,73
  268. 268 DATA 83,32,70,73,76,69,34,58,137,49
  269. 269 DATA 48,0,0,0
  270.